open List;;
open Hashtbl;;
open Common;;

type color = 
  | Club
  | Heart
  | Diamond
  | Spade;;
  
let string_of_color = function
  | Club    -> "Club"
  | Heart   -> "Heart"
  | Diamond -> "Diamond"
  | Spade   -> "Spade"  ;;
  
type value =
  | As    
  | King  
  | Queen 
  | Joker 
  | Ten   
  | Nine  
  | Eight 
  | Seven 
  | Six   
  | Five  
  | Four  
  | Three 
  | Two;;
  
let string_of_value = function
  | As    -> "As"   
  | King  -> "King" 
  | Queen -> "Queen" 
  | Joker -> "Joker" 
  | Ten   -> "Ten"   
  | Nine  -> "Nine"  
  | Eight -> "Eight" 
  | Seven -> "Seven" 
  | Six   -> "Six"   
  | Five  -> "Five" 
  | Four  -> "Four"  
  | Three -> "Three" 
  | Two   -> "Two" ;;


  
type card = value*color;;

let string_of_card (value,color) = 
  string_of_value value ^ string_of_color color;;

let rec string_of_card_list = function
  | h::t -> (string_of_card h)^" "^(string_of_card_list t)
  | []   -> ""
  


	
let  get_color card = 
  match card with
    | _,color -> color;;

let get_value card = 
  match card with
    |value,_ ->value;;

let valuate = function 
  | As,    _ -> 14
  | King,  _ -> 13
  | Queen, _ -> 12
  | Joker, _ -> 11
  | Ten,   _ -> 10
  | Nine,  _ -> 9
  | Eight, _ -> 8
  | Seven, _ -> 7
  | Six,   _ -> 6
  | Five,  _ -> 5
  | Four,  _ -> 4
  | Three, _ -> 3
  | Two,   _ -> 2;;
  
let compare_cards card_a card_b = 
  match (get_value card_a), (get_value card_b) with
    | c1, c2-> (valuate card_b ) - (valuate card_a);;

let rec compare_card_list cl1 cl2 = 
  match cl1, cl2 with
    | h1::t1, h2::t2 when ((<>)(compare_cards h1 h2) 0) -> compare_cards h1 h2
    | h1::_, h2::_ -> compare_cards h1 h2
    |    _,_     -> 0

  
let succ_card (card:card) = 
  match card with
    | As,    color -> Two, color
    | King,  color -> As, color
    | Queen, color -> King, color
    | Joker, color -> Queen, color
    | Ten,   color -> Joker, color
    | Nine,  color -> Ten, color
    | Eight, color -> Nine, color
    | Seven, color -> Eight, color
    | Six,   color -> Seven, color
    | Five,  color -> Six, color
    | Four,  color -> Five, color
    | Three, color -> Four, color
    | Two,   color -> Three, color;;
  
let pred_card (card:card) = 
  match card with
  | As,    color -> King, color
  | King,  color -> Queen, color
  | Queen, color -> Joker, color
  | Joker, color -> Ten, color
  | Ten,   color -> Nine, color
  | Nine,  color -> Eight, color
  | Eight, color -> Seven, color
  | Seven, color -> Six, color
  | Six,   color -> Five, color
  | Five,  color -> Four, color
  | Four,  color -> Three, color
  | Three, color -> Two, color
  | Two,   color -> As, color;;

  

let count_color card_list =
  let spade, heart, diamond, club = ref [], ref [], ref [], ref [] in
  let rec count_color_rec card_list =
    match List.rev (List.sort compare_cards card_list) with
      | (( _ ,Spade) as card) ::t   -> spade   := card::!spade; count_color_rec t 
      | (( _ ,Diamond) as card) ::t -> diamond := card::!diamond; count_color_rec t
      | (( _ ,Club) as card) ::t    -> club    := card::!club; count_color_rec t 
      | (( _ ,Heart) as card) ::t   -> heart   := card::!heart; count_color_rec t
      | []               -> () in
    count_color_rec card_list;
    (!spade, !heart, !club, !diamond);;  



let rec print_card_list card_list =
  match card_list with
    | h::t -> print_string (string_of_card h);print_string " "; print_card_list t
    |[]    -> print_newline();;
  
let rec print_card_list_list card_list_list = 
  match card_list_list with
    | h::t -> print_card_list h; print_card_list_list t
    |[]    -> print_newline();;
   
let count_card card_list = 
  let tbl = Hashtbl.create 13 in
  let rec count_card_rec  =  function
    | (( value, color ) as card) ::t -> let sov = string_of_value value in
        if   Hashtbl.mem tbl sov 
        then (Hashtbl.replace tbl sov (card::(Hashtbl.find tbl sov)); count_card_rec t)
        else ( Hashtbl.add tbl sov (card::[]); count_card_rec t)
    | [] -> () in
    count_card_rec card_list;
    tbl;;


let same_value a b = 
  ((=) (compare_cards a b ) 0);;


let rec  hight_card card_list = 
  let sl = List.sort compare_cards card_list in
    (true, sl);;

let pair card_list= 
  let tbl = count_card card_list in
  let list = (Hashtbl.fold get_bind  tbl []) in
  let test l  = (List.length l ) >= 2 in
    if (List.exists test list)
    then (true, List.find test list )
    else (false, []);;

let three_of_a_kind card_list= 
  let tbl = count_card card_list in
  let list = (Hashtbl.fold get_bind  tbl []) in
  let test l = (List.length l ) >= 3 in
    if (List.exists test list)
    then (true, List.find test list )
    else (false, []);;

let four_of_a_kind card_list =
  let tbl = count_card card_list in
  let list = (Hashtbl.fold get_bind  tbl []) in
  let test l = (List.length l ) >= 4 in
    if (List.exists test list)
    then (true, List.find test list )
    else (false, []);;

let full_house card_list = 
  let rec test  = function
      | a::b::l -> (List.length a) >= 3 && (List.length b) >= 2
      | s::l -> test l
      | [] -> false  in
  let tbl = count_card card_list in
  let list = (Hashtbl.fold get_bind  tbl []) in
  let slist =  sort compare list  in
    if test slist
    then (true, (List.concat ((hd slist)::(nth slist 1)::[] )))
    else (false, []);; 
 
let double_pair card_list = 
  let rec test  = function
      | a::b::l when ((List.length a) >= 2 && (List.length b) >= 2) ->  true
      | s::l -> test l
      | [] -> false  in
  let tbl = count_card card_list in
  let list = (Hashtbl.fold get_bind  tbl []) in
  let slist =  (sort compare list ) in
    if test slist
    then (true, (List.concat ((hd slist)::(nth slist 1)::[])) )
    else (false, []);; 

let low_straight card_list = 
  let as_c    = List.exists (same_value (As,Club))     card_list  in
  let two_c   = List.exists (same_value (Two,Club))    card_list  in
  let three_c = List.exists (same_value (Three,Club))  card_list  in
  let four_c  = List.exists (same_value (Four,Club))   card_list  in
  let five_c  = List.exists (same_value (Five,Club))   card_list  in
    if as_c & two_c & three_c & four_c & five_c
    then 
      (
	let as_c    = List.find (same_value (As,Club))     card_list  in
	let two_c   = List.find (same_value (Two,Club))    card_list  in
	let three_c = List.find (same_value (Three,Club))  card_list  in
	let four_c  = List.find (same_value (Four,Club))   card_list  in
	let five_c  = List.find (same_value (Five,Club))   card_list  in
	  (true,[as_c; two_c; three_c; four_c; five_c])
      )
    else (false,[])




let straight card_list = 
  let b,lc = low_straight card_list in
    if b 
    then (b, lc)
    else
      (
        let sorted_list = List.sort compare_cards  card_list in
	let counter = ref [] in
	let rec straight_rec = function 
	  | h::t when !counter = [] -> counter := h::[]; straight_rec t
	  | h::t when same_value h (List.hd !counter) -> straight_rec t
	  | h::t when same_value  h (pred_card (List.hd !counter)) -> counter := h::!counter;  straight_rec t
	  | h::t  ->  straight_rec t
	  | [] -> () in
	  straight_rec sorted_list;
	  if (List.length !counter) >= 5   
	  then 
	    begin
	      let result = ref  [] in
	      let rec five_higthest_cards l =
		let b,hight_c = hight_card l in
		let hc = hd hight_c in
		  result := hc::!result ;
		  if not ((List.length !result)=5)
		  then (five_higthest_cards  (remove_list_element l hc)) in
		five_higthest_cards !counter;
		(true,List.sort compare_cards !result)
	    end
	  else (false, [])
      );;




let flush card_list =
  let (spade, heart, club, diamond) = count_color card_list in
    if (List.length spade) >=5 
    then (true, spade)
    else if (List.length heart) >=5 
    then (true, heart)
    else if (List.length club ) >=5 
    then (true, club)
    else if (List.length diamond ) >=5 
    then (true, diamond)
    else (false, []);; 



let straight_flush card_list = 
  let h = flush card_list in
    match h with
      | false, _   -> false, []
      | true, cards -> 
	  let s  = straight cards in
	    match s with 
	      | false, _ -> false, []
	      | true, cards -> s;;



let royal_straight_flush card_list =  
  let b1,sf = straight_flush card_list in
    if b1 then
      (
	let b2,hight_c =  (hight_card sf) in
	let hc = hd hight_c in
	let b2 =((=)( compare_cards hc (As,Club)  ) 0) in
	  if b1=b2 
	  then (true, sf)
	  else (false, [])
      )
    else (false, []);;



    
 

let testfunction () =
  let card_a = As,    Club in
  let card_b = Two,   Club in
  let card_c = Three, Club in
  let card_d = Four,  Club in
  let card_e = Six,   Club in
  let card_f = Five,  Club in
  let card_g = King,  Diamond in
  let card_h = As,    Heart in
  let card_i = As,    Spade in

  (*hight_card*)
  let card_list_a =  [card_a; card_c;] in
    (*pair*)
  let card_list_b =  [card_a; card_f; card_c; card_d; card_e] in
    (*double_pair*)
  let card_list_c =  [card_a; card_f; card_b; card_g; card_e; card_c] in
    (*three_of_a_kind*)
  let card_list_d =  [card_a; card_f; card_h; card_d; card_e] in
    (*straight*)
  let card_list_e =  [card_a; card_b; card_c; card_d; card_e; card_f; card_g] in
    (*flush*)
  let card_list_f =  [card_a; card_b; card_c; card_d; card_e; card_f; card_g] in
    (*full_house*)
  let card_list_g =  [card_a; card_f; card_i; card_b; card_g; card_c] in
    (*four_of_a_kind*)
  let card_list_h =  [card_a; card_h; card_i; card_f; card_e; card_c] in
    (*straight_flush*)
  let card_list_i =  [card_a; card_b; card_c; card_d; card_e; card_h; card_i] in
    (*royal_straight_flush*)
  let card_list_j =  [card_a; card_b; card_c; card_d; card_e; card_f; card_g] in


  let a = hight_card card_list_a in
  let b = pair card_list_b in
  let c = double_pair card_list_c in
  let d = three_of_a_kind card_list_d in
  let e = low_straight card_list_e in
  let f = flush card_list_f in
  let g = full_house card_list_g in
  let h = four_of_a_kind card_list_h in
  let i = straight_flush card_list_i in
  let j = royal_straight_flush card_list_j in
  let print_hand (boolean,card_list) = 
    if boolean 
    then print_card_list card_list 
    else print_string "*******\n" in




    print_string "hight_card\n";
    print_hand a;
    print_string "pair\n"; 
    print_hand b; 
    print_string "double_pair\n";
    print_hand c;
    print_string "three_of_a_kind\n";
    print_hand d;
    print_string "straight\n";
    print_hand e;
    print_string "flush\n";
    print_hand f;
    print_string "full_house\n";
    print_hand g;
    print_string "four_of_a_kind\n";
    print_hand h;
    print_string "straight_flush\n";
    print_hand i;
    print_string "royal_straight_flush\n";
    print_hand j;;

